Attribute VB_Name = "modMain"
Option Explicit
Public Const currVer = "1.39"
Public Const verdate = "14h25 OCT, 21 2009"
Public Const updatelink = "http://galileo.com.vn/down/liveupdate/versioninfo.htm"

Public adoConnection As New ADODB.Connection
Public gRs As New ADODB.Recordset
Public cns As String
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public stroffice As String
Public CurrentUser As String
Public isLoged As Boolean
Public permit As String
Public Const BO_VERSION = "1.50"
Public OKPass As Boolean
Public sPASSWORD As String
Public sUserNameStore As String
Public TotalExpenditureInCashFlow As Variant
Public TotalExpenditureCheck As Variant
Public isFillCheck As Integer
Public isCreateNewExcel As Boolean
Public ApExcel As Excel.Application
Public CounterSheet As Integer
Public isExportExpenditureForGindo As Boolean

Public ItemRemember As String
Public path_fileExport As String
Public path_fileImport As String



Public Function GetFieldValue(FF As ADODB.Field) As String
    If Not IsNull(FF.Value) Then
        GetFieldValue = FF.Value
    Else
        GetFieldValue = ""
    End If
End Function

Public Function WriteCurrentVersionToFile(currVer As String)
    Open App.Path & "\CurrVer.dat" For Output As #1
        Print #1, currVer
        Print #1, verdate
    Close #1
End Function

Public Function GetCurrentVersion() As String
    Dim currVer As String
    Open App.Path & "\CurrVer.dat" For Input As #1
        Line Input #1, currVer
    Close #1
        GetCurrentVersion = currVer
End Function
Public Function GetCurrentVersionDate() As String
    Dim currVerDate As String
    Open App.Path & "\CurrVer.dat" For Input As #1
        Line Input #1, currVerDate
        Line Input #1, currVerDate
    Close #1
        GetCurrentVersionDate = currVerDate
End Function

Public Function exportData()
    Dim rs1 As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim sql As String
    Dim i As Integer
    Dim cnn As New ADODB.Connection
    
    If cnn.State = adStateOpen Then cnn.Close
    cnn.CursorLocation = adUseClient
    
    path_fileExport = App.Path & "\export\" & stroffice & "_" & "exportdata.dat"
    Call DisconnectDB
    
    If GetAutoticketingDBPath = "" Then
        Call FileCopy(App.Path & "\db.mdb", path_fileExport)
    Else
        Call FileCopy(GetAutoticketingDBPath, path_fileExport)
    End If
    
    Call KetNoi
    
    If Dir(path_fileExport) = "" Then
        MsgBox "There is no file to export, contact with SD department"
        Exit Function
    End If
    
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & path_fileExport
    
    'sql="Create table offdata
    sql = "delete from office"
    cnn.Execute (sql)
    sql = "insert into office values('" & stroffice & "','U')"
    cnn.Execute (sql)
    
    Call copytable("balance")
    Call copytable("detail")
    Call copytable("headers")
    Call copytable("MoneyExchange")
    Call copytable("ROE")
    
    If isQueryExist("esheaders") Then
        Call copytable("esheaders")
    End If
    
    If isQueryExist("esheaders") Then
        Call copytable("estimated")
    End If
    
    
    
    Set cnn = Nothing
    Call CompactRepairAccessDB(path_fileExport)
    MsgBox "Data exported successfully to folder EXPORT"
    
End Function

Public Function ImportData(ByVal stroffice As String) As Boolean
    Dim rs1 As New ADODB.Recordset
    Dim sql As String
    Dim i As Integer
    Dim Office As String
    Dim cnn As New ADODB.Connection
    
    path_fileImport = App.Path & "\IMport\" & stroffice & "_" & "exportdata.dat"
    If Dir(path_fileImport) = "" Then
        ImportData = False
        Exit Function
    End If
    
    If cnn.State = adStateOpen Then cnn.Close
    
    cnn.CursorLocation = adUseClient
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & path_fileImport
    
'    sql = "select * from office"
'    Set rs1 = cnn.Execute(sql)
'     If Not rs1.EOF Then
'        Office = rs1.Fields(0).Value
'     Else
'        MsgBox "Error data format to import"
'        Exit Function
'     End If
    Call copyTableImport("balance", stroffice)
    Call copyTableImport("detail", stroffice)
    Call copyTableImport("headers", stroffice)
    Call copyTableImport("MoneyExchange", stroffice)
    Call copyTableImport("ROE", stroffice)
    
    Call copyTableImport("esheaders", "G" & stroffice)
    Call copyTableImport("estimated", "G" & stroffice)
    
    Set cnn = Nothing
    ImportData = True
    Call FileSystem.Kill(path_fileImport)
End Function

Public Function ImportAllData()
    Dim returnValue As Boolean
    returnValue = False
    If ImportData("SGN") Then
        returnValue = True
        'Call FileSystem.Kill(App.Path & "\Import\sgn_exportdata.dat")
    End If
    If ImportData("HAN") Then
        returnValue = True
    End If
    If ImportData("IND") Then
        returnValue = True
    End If
    If ImportData("VTE") Then
        returnValue = True
    End If
    If ImportData("PNH") Then
        returnValue = True
    End If
    If returnValue Then
        MsgBox "Data imported successfully", vbOKOnly + vbInformation, "Accounting software"
    Else
        MsgBox "There is nothing to import", vbOKOnly + vbCritical, "Accounting software"
    End If
End Function

Public Function addROE(roeDate As String, ROE As Variant, loginID As String, offc As String) As Boolean
    On Error GoTo L
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "select * from roe where OFFICE ='" & offc & "' AND left(dateROE,4)='" & Left(roeDate, 4) & "' and mid(dateROE,5,2) ='" & Mid(roeDate, 5, 2) & "'"
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        'If MsgBox("ROE of this date is already in database, do you want to overwite this one?", vbQuestion + vbYesNo, "Add ROE question") = vbYes Then
            'sql = "delete * from roe where dateroe ='" & roeDate & "' and OFFICE='" & offc & "'"
            sql = "delete * from roe where OFFICE ='" & offc & "' AND left(dateROE,4)='" & Left(roeDate, 4) & "' and mid(dateROE,5,2) ='" & Mid(roeDate, 5, 2) & "'"
            adoConnection.Execute (sql)
        'Else
            'addROE = False
            'Exit Function
        'End If
    End If
    sql = "insert into roe(dateROE,roe,loginID,OFFICE) values(" & roeDate & "," & ROE & ",'" & loginID & "','" & offc & "')"
    adoConnection.Execute sql
    addROE = True
    Exit Function
L:
    addROE = False

End Function

Public Function copyTableImport(tablename As String, Office As String)
    On Error GoTo L
    Dim rs1 As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim sql As String
    Dim i As Integer
    Dim cnn As New ADODB.Connection
    
    
    If cnn.State = adStateOpen Then cnn.Close
    cnn.CursorLocation = adUseClient
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\import\" & Right(Office, 3) & "_" & "exportdata.dat"
    
    sql = "select * from " & tablename
    cnn.Execute (sql)
    
    sql = "Select * from " & tablename & " where office ='" & Office & "'"
    Set rs1 = cnn.Execute(sql)
    sql = "Delete * from " & tablename & " where office ='" & Office & "'"
    adoConnection.Execute (sql)
    sql = "Select * from " & tablename
    rs2.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    While Not rs1.EOF
        rs2.AddNew
        For i = 0 To rs1.Fields.Count - 1
            If Not IsNull(rs1.Fields(i).Value) Then
                rs2.Fields(i).Value = rs1.Fields(i).Value
            End If
        Next i
        rs2.Update
        rs1.MoveNext
    Wend
    rs1.Close
    rs2.Close
    
    Set rs1 = Nothing
    Set rs2 = Nothing
    cnn.Close
    Set cnn = Nothing
    Exit Function
L:
    cnn.Close
    Set cnn = Nothing
End Function
Public Function copyOneTimeImport()
    On Error GoTo L
    Dim rs1 As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim sql As String
    Dim i As Integer
    Dim cnn As New ADODB.Connection
    
            
    If cnn.State = adStateOpen Then cnn.Close
    cnn.CursorLocation = adUseClient
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\onetime.dat"
    
    sql = "Delete * from esheaders where esapplymonth='ALL' and esapplyyear='2009'"
    adoConnection.Execute (sql)
    sql = "Delete * from estimated where esapplymonth='ALL' and esapplyyear='2009'"
    adoConnection.Execute (sql)
    
    sql = "Select * from esheaders where esapplymonth='ALL' and esapplyyear='2009'"
    Set rs1 = cnn.Execute(sql)
    sql = "Select * from esheaders"
    rs2.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    While Not rs1.EOF
        rs2.AddNew
        For i = 0 To rs1.Fields.Count - 1
            If Not IsNull(rs1.Fields(i).Value) Then
                If Len(rs1.Fields(i).Value) > 250 Then
                    rs2.Fields(i).Value = Left(rs1.Fields(i).Value, 250)
                Else
                    rs2.Fields(i).Value = rs1.Fields(i).Value
                End If
            End If
        Next i
        rs2.Update
        rs1.MoveNext
    Wend
    rs1.Close
    rs2.Close
    
    sql = "Select * from estimated where esapplymonth='ALL' and esapplyyear='2009'"
    Set rs1 = cnn.Execute(sql)
    sql = "Select * from estimated"
    rs2.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    While Not rs1.EOF
        rs2.AddNew
        For i = 0 To rs1.Fields.Count - 1
            If Not IsNull(rs1.Fields(i).Value) Then
                    If Len(rs1.Fields(i).Value) > 250 Then
                        rs2.Fields(i).Value = Left(rs1.Fields(i).Value, 250)
                    Else
                        rs2.Fields(i).Value = rs1.Fields(i).Value
                    End If
                 
            End If
        Next i
        rs2.Update
        rs1.MoveNext
    Wend
    rs1.Close
    rs2.Close
    
    Set rs1 = Nothing
    Set rs2 = Nothing
    cnn.Close
    Set cnn = Nothing
    Exit Function
L:
    cnn.Close
    Set cnn = Nothing
End Function

Public Function copytable(tablename As String)
    On Error GoTo L
    Dim rs1 As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim sql As String
    Dim i As Integer
    Dim cnn As New ADODB.Connection
        If cnn.State = adStateOpen Then cnn.Close
        cnn.CursorLocation = adUseClient
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & path_fileExport
        If tablename = "esheaders" Or tablename = "estimated" Then
            sql = "Select * from " & tablename & " where office ='G" & stroffice & "'"
        Else
            sql = "Select * from " & tablename & " where office ='" & stroffice & "'"
        End If
        
        sql = "select * from " & tablename
        cnn.Execute (sql)
        
        Set rs1 = adoConnection.Execute(sql)
        sql = "Delete * from " & tablename
        cnn.Execute (sql)
        sql = "Select * from " & tablename
        rs2.Open sql, cnn, adOpenDynamic, adLockOptimistic, adCmdText
        While Not rs1.EOF
            rs2.AddNew
            For i = 0 To rs1.Fields.Count - 1
                'If Not IsNull(rs1.Fields(i).Value) Then
                    rs2.Fields(i).Value = GetFieldValue(rs1.Fields(i))
                'Else
                
                'End If
            Next i
            rs2.Update
            rs1.MoveNext
        Wend
        rs1.Close
        rs2.Close
        
        Set rs1 = Nothing
        Set rs2 = Nothing
L:
        cnn.Close
        Set cnn = Nothing
End Function
Public Function getAverageROE(strMonth As String, strYear As String, Office As String) As Variant
    Dim sql As String
    Dim nTotal, nRows As Variant
    Dim rs As New ADODB.Recordset
    Dim offc As String
    If Len(Office) > 3 Then
        offc = Right(Office, 3)
    Else
        offc = Office
    End If
    sql = "Select sum(roe) from roe where OFFICE ='" & offc & "' AND left(dateROE,4)='20" & strYear & "' and mid(dateROE,5,2) ='" & strMonth & "'"
    Set rs = adoConnection.Execute(sql)
    nTotal = 0
    nRows = 1
    getAverageROE = 1
    If Not rs.EOF Then
        If Not IsNull(rs.Fields(0).Value) Then
            nTotal = rs.Fields(0).Value
        End If
    End If
    
    sql = "Select  roe from roe where OFFICE ='" & offc & "' AND left(dateROE,4)='20" & strYear & "' and mid(dateROE,5,2) ='" & strMonth & "'"
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        If Not IsNull(rs.Fields(0).Value) Then
            nRows = rs.RecordCount
        End If
    End If
    If nRows > 0 Then
        getAverageROE = nTotal / nRows
    End If
    rs.Close
    Set rs = Nothing
End Function

Public Function staruptime()
    On Error Resume Next
    Dim justUpdate As String
    Dim oldversion As String
    Dim Newversion As String
    Dim strUpdateDatabseResult As String
    Dim LastdateBackup As String
    Dim sql As String
    Dim rs As New ADODB.Recordset
    'ApExcel.Quit
    Call KetNoi
    
     If Dir(App.Path & "\onetime.dat") <> "" Then
        Call copyOneTimeImport
        FileSystem.Kill App.Path & "\onetime.dat"
     End If
     
    sql = "SELECT * FROM typelist where name='PAYFO'"
    Set rs = adoConnection.Execute(sql)
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        sql = "insert into typelist(NAME,DES,BILL) values('PAYFO','Pay for outsite','IV')"
        adoConnection.Execute (sql)
    End If
    
    sql = "Update office set name ='GIND' where name ='GDAD'"
    
    adoConnection.Execute (sql)
    Call DisconnectDB
    If getSettingValue("enabledbackup") = "1" And getSettingValue("Autobackup") = "1" Then
        If isBackupNow(getSettingValue("lastbackup")) Then
            BackupData
        End If
    ElseIf getSettingValue("enabledbackup") = "1" And getSettingValue("Autobackup") = "0" Then
        If isBackupNow(getSettingValue("lastbackup")) Then
            If MsgBox("It is time for data backup. Do you want to backup?(Y/N)", vbQuestion + vbYesNo, "Backup") = vbYes Then
                If BackupData Then
                    MsgBox "Backup is successful", vbInformation + vbOKOnly, "Backup"
                Else
                    MsgBox "Error: System can not backup your data, please Contact the developer", vbCritical + vbOKOnly, "Error"
                   
                End If
            End If
        End If
    End If
    strUpdateDatabseResult = UpdateDatabase(GetCurrentVersion)
    If strUpdateDatabseResult = 1 Then
        MsgBox "Database upgrade is successful", vbInformation, "Update database"
    ElseIf strUpdateDatabseResult = 0 Then
        MsgBox "An error occurred while upgrading database, Please contact with software development!", vbCritical + vbOKOnly, "Upgrade database"
        End
        
    End If
    
    
    If Dir(App.Path & "\starup.ini") = "" Then
        Exit Function
    End If
     Open App.Path & "\starup.ini" For Input As #1
        Line Input #1, justUpdate
        Line Input #1, Newversion
        Close #1
        If Right(justUpdate, 1) = "1" Then
            Open App.Path & "\starup.ini" For Output As #1
            justUpdate = "justUpdate=0"
            Print #1, justUpdate
            Print #1, Newversion
            Close #1
            oldversion = GetCurrentVersion
            MsgBox "You have been successfully in upgrading from version " & oldversion & " to version " & Right(Newversion, Len(Newversion) - Len("Newversion=")), vbInformation + vbOKOnly, "Live Update"
        End If
End Function

Public Function downloadUpdateFile()

End Function
Public Function getAverageROEforExpenditure(strMonth As String, strYear As String, Office As String) As String
    Dim sql As String
    Dim nTotal, nRows As Variant
    Dim arrROE As String
    Dim rs As New ADODB.Recordset
    arrROE = ""
    If Len(Office) <= 3 Then
        Office = "G" & Office
    End If
    sql = "Select roe from MoneyExchange where moffc ='" & Office & "' AND mid(mdate,3,2)='" & strMonth & "' and left(mdate,2) ='" & strYear & "'  and (Approved is null or Approved='' or  Approved ='1')" ' and  left(musd,1)='-'"
    Set rs = adoConnection.Execute(sql)
    'rs.MoveFirst
    getAverageROEforExpenditure = ""
    While Not rs.EOF
        If GetFieldValue(rs.Fields(0)) <> "" Then
            If Len(Trim(arrROE)) <= 0 Then
                arrROE = rs.Fields(0).Value
            Else
                arrROE = arrROE & "," & rs.Fields(0).Value
            End If
        End If
        rs.MoveNext
    Wend
    
    If Len(arrROE) > 0 Then
        getAverageROEforExpenditure = arrROE
    Else
        getAverageROEforExpenditure = "0"
    End If
    rs.Close
    Set rs = Nothing
End Function

Public Function isExistROE(strMonth As String, strYear As String, Office As String) As Boolean
    Dim sql As String
    Dim nTotal, nRows As Variant
    Dim rs As New ADODB.Recordset
    sql = "Select sum(roe) from roe where OFFICE ='" & Office & "' AND left(dateROE,4)='20" & strYear & "' and mid(dateROE,5,2) ='" & strMonth & "'"
    Set rs = adoConnection.Execute(sql)
    isExistROE = False
    If Not rs.EOF Then
        If Not IsNull(rs.Fields(0).Value) Then
            isExistROE = True
        End If
    End If
    rs.Close
    Set rs = Nothing
End Function

Public Function isExistBalance(bMonth As String, bYear As String, Office As String) As Boolean
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim strCon As String
    isExistBalance = False
     
    sql = "select * from balance where OFFICE ='" & Office & "' AND BalanceMonth='" & bMonth & "' and BalanceYear='" & bYear & "'"
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        If Not IsNull(rs.Fields(0).Value) Then
            isExistBalance = True
        End If
    End If
    rs.Close
    Set rs = Nothing
End Function
Public Function isExistActualBalance(bMonth As String, bYear As String, Office As String) As Boolean
    On Error GoTo L
        Dim sql As String
        Dim rs As New ADODB.Recordset
        isExistActualBalance = False
        'creatdate = formatYYYYMMDD(Day(Now()), Month(Now()), Right(Year(Now()), 2))
        sql = "select * from balance where BalanceMonth='" & bMonth & "' and BalanceYear='" & bYear & "' and  office ='" & Office & "' and IsActual='AUTO'"
        Set rs = adoConnection.Execute(sql)
        If Not rs.EOF Then
            isExistActualBalance = True
        End If
        rs.Close
        Set rs = Nothing
        Exit Function
L:
    isExistActualBalance = False
End Function

Public Function SetActualBalanceToDB(bMonth As String, bYear As String, UBUSD As String, UCUSD As String, UBVND As String, UCVND As String, Office As String) As Boolean
     On Error GoTo L
        Dim sql As String
        Dim creatdate As String
        SetActualBalanceToDB = False
        creatdate = formatYYYYMMDD(Day(Now()), Month(Now()), Year(Now()))
        If isExistActualBalance(bMonth, bYear, Office) Then
            sql = "Delete * from balance where BalanceMonth='" & bMonth & "' and BalanceYear='" & bYear & "' and OFFICE='" & Office & "' and IsActual='AUTO'"
            adoConnection.Execute sql
        End If
        sql = "INSERT INTO balance(Createdate, BalanceMonth, BalanceYear, UBUSD, UCUSD, UBVND, UCVND,Userlogin,office,isactual) VALUES('" & creatdate & "','" & bMonth & "','" & bYear & "','" & UBUSD & "','" & UCUSD & "','" & UBVND & "','" & UCVND & "','" & CurrentUser & "','" & Office & "','AUTO')"
        adoConnection.Execute sql
        SetActualBalanceToDB = True
        Exit Function
L:
    SetActualBalanceToDB = False
End Function

Public Function getBalance(isBank As Boolean, isUSD As Boolean, bMonth As String, bYear As String, Office As String) As Variant
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim strCon As String
    If (isBank = True) And (isUSD = True) Then
        strCon = " select ubusd from balance "
    ElseIf (isBank = True) And (isUSD = False) Then
        strCon = " select ubvnd from balance "
    ElseIf (isBank = False) And (isUSD = False) Then
         strCon = " select ucvnd from balance "
    ElseIf (isBank = False) And (isUSD = True) Then
        strCon = " select ucusd from balance "
    End If
    getBalance = 0
    strCon = strCon & " where OFFICE ='" & Office & "' AND BalanceMonth='" & bMonth & "' and BalanceYear='" & bYear & "'"
    Set rs = adoConnection.Execute(strCon)
    If Not rs.EOF Then
        If Not IsNull(rs.Fields(0).Value) Then
            getBalance = rs.Fields(0).Value
        End If
    End If
    rs.Close
    Set rs = Nothing
End Function


Public Function ToApprove(IMnumber As String, subid As Integer, Office As String, IsApprove As Boolean, isMoneyExchange As Boolean, refuseNote As String) As Boolean
    On Error GoTo err
    Dim sql, sql2, sql3 As String
    Dim ApproveRefuse As String
    Dim delOffice As String
    On Error GoTo err
    
    If IsApprove Then
        ApproveRefuse = "1"
    Else
        ApproveRefuse = "0"
    End If
    
    
    delOffice = Office
    
    If Not isMoneyExchange Then
        sql = "update detail set approved ='" & ApproveRefuse & "',RefuseNote='" & refuseNote & "' where office ='" & delOffice & "' and subid =" & subid
        sql2 = "insert into approved values('" & IMnumber & "','" & Office & "','I','" & ApproveRefuse & "')"
        sql3 = "Delete from approved where  office ='" & delOffice & "' and IMnumber ='" & IMnumber & "'"
    Else
        sql = "update MoneyExchange set approved ='" & ApproveRefuse & "',RefuseNote='" & refuseNote & "' where office ='" & delOffice & "' and  mnumber ='" & IMnumber & "'"
        sql2 = "insert into approved values('" & IMnumber & "','" & Office & "','M','" & ApproveRefuse & "')"
        sql3 = "Delete from approved where  office ='" & delOffice & "' and IMnumber ='" & IMnumber & "'"
    End If
    adoConnection.Execute (sql)
    adoConnection.Execute (sql3)
    adoConnection.Execute (sql2)
    ToApprove = True
    Exit Function
err:
    ToApprove = False
End Function
Public Function EstimatedRemoveItem(esmonth As String, esyear As String, Office As String) As Boolean
    Dim sql As String
    Dim delOffice As String
    On Error GoTo err
    
    If permit <> "A" Then
        delOffice = stroffice
    Else
        delOffice = Office
    End If
    sql = "delete  from esheaders where office ='" & Office & "' and esapplymonth ='" & esmonth & "' and esapplyyear='" & esyear & "'"
    adoConnection.Execute (sql)
    sql = "delete  from estimated where office ='" & Office & "' and esapplymonth ='" & esmonth & "' and esapplyyear='" & esyear & "'"
    adoConnection.Execute (sql)
    EstimatedRemoveItem = True
    Exit Function
err:
    EstimatedRemoveItem = False
End Function

Public Function EstimatedExist(esmonth As String, esyear As String, Office As String) As Boolean
    Dim sql As String
    Dim delOffice As String
    Dim rs As New ADODB.Recordset
    
    
    sql = "select * from estimated where office ='" & Office & "' and esapplymonth ='" & esmonth & "' and esapplyyear='" & esyear & "'"
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        EstimatedExist = True
    Else
        EstimatedExist = False
    End If
End Function

Public Function RemoveItem(subid As Integer, Office As String) As Boolean
    Dim sql As String
    Dim delOffice As String
    On Error GoTo err
    
    If permit <> "A" Then
        delOffice = stroffice
    Else
        delOffice = Office
    End If
    sql = "delete * from headers where office ='" & delOffice & "' and subid =" & subid
    adoConnection.Execute (sql)
    sql = "delete * from detail where office ='" & delOffice & "' and subid =" & subid
    adoConnection.Execute (sql)
    RemoveItem = True
    Exit Function
err:
    RemoveItem = False
End Function
Public Function UpdateDatabase(strVersion As String) As String
    On Error GoTo err
    Dim sql As String
    Dim returnValue As String
    returnValue = 2
     
        Call KetNoi
        
    
        
        If Not isTableExist("Approved", "detail") Then
            adoConnection.Execute ("alter table detail add Approved varchar(50)")
            adoConnection.Execute ("ALTER TABLE detail ALTER COLUMN Approved SET DEFAULT 0")
            returnValue = 1
        End If
        
        If Not isTableExist("RefuseNote", "detail") Then
            adoConnection.Execute ("alter table detail add RefuseNote varchar(255)")
            returnValue = 1
        End If
        
        If Not isTableExist("Approved", "MoneyExchange") Then
            adoConnection.Execute ("alter table MoneyExchange add Approved varchar(50)")
            adoConnection.Execute ("ALTER TABLE MoneyExchange ALTER COLUMN Approved SET DEFAULT 0")
            returnValue = 1
        End If
        
        If Not isTableExist("RefuseNote", "MoneyExchange") Then
            adoConnection.Execute ("alter table MoneyExchange add RefuseNote varchar(255)")
            returnValue = 1
        End If
        
        If Not isQueryExist("approved") Then
            adoConnection.Execute ("create table approved (IMnumber varchar(50),Office varchar(50),InvoiceME varchar(50),isApproved  varchar(50))")
            returnValue = 1
        End If
        
        If Not isQueryExist("estimated") Then
            adoConnection.Execute ("create table estimated (Office varchar(50),esdate varchar(50),esmonth varchar(50),esyear  varchar(50),esapplymonth varchar(50),esapplyyear varchar(50),esinputby varchar(50),esnote varchar(255))")
            returnValue = 1
        End If
        
        If Not isQueryExist("esheaders") Then
            adoConnection.Execute ("create table esheaders (esapplymonth varchar(50),esapplyyear varchar(50),office varchar(50),esitem varchar(50),esvalue varchar(50),esowner varchar(50),esdes varchar(255))")
            returnValue = 1
        Else
    '             If Not isTableExist("office", "esheaders") Then
    '                adoConnection.Execute ("ALTER TABLE esheaders RENAME  COLUMN  esoffice TO office")
    '                returnValue = 1
    '            End If
        End If
        
        adoConnection.Execute ("update tbl_Pass set Permit='U' where username ='acsgn' or username ='acgla' or username ='acgkh'")
        adoConnection.Execute ("update tbl_Pass set pass='password@',Permit='A' where username ='admin'")
        
        If returnValue = 1 Then
                If isQueryExist("CASHFLOW") Then
                    DeleteAccessQuery ("CASHFLOW")
                End If
                sql = "SELECT detail.subid, (Right(detail.cdate,2) & Mid(detail.cdate,3,2)) AS cdatemonth, Mid(detail.cdate,3,2) AS cmonth, Left(detail.cdate,2) AS cYear, headers.isusd, headers.isbank, headers.ivalue, headers.itype, headers.ioffc, detail.inumber, detail.OFFICE, detail.Approved from detail, headers WHERE (((detail.subid)=headers.subid) And ((detail.OFFICE)=headers.office) And ((Left(headers.itype,2))='BI' Or (Left(headers.itype,2))='BO') And ((detail.BillType)='BF')) And (detail.Approved Is Null Or detail.Approved='' Or detail.Approved='1');"
                Call CreateAccessQuery("CASHFLOW", sql)
                
                If isQueryExist("revalue") Then
                    DeleteAccessQuery ("revalue")
                End If
                sql = "SELECT detail.subid, (Right(detail.cdate,2) & Mid(detail.cdate,3,2)) AS cdatemonth, Mid(detail.cdate,3,2) AS cmonth, Left(detail.cdate,2) AS cYear, headers.isusd, headers.isbank, headers.ivalue, headers.itype, headers.ioffc, detail.inumber, detail.OFFICE, detail.OFFICE FROM detail, headers WHERE (((detail.subid)=headers.subid) And ((detail.OFFICE)=headers.office) And ((Left(headers.itype,1))='R') And ((detail.BillType)='RC')) And (detail.Approved Is Null Or detail.Approved='' Or detail.Approved='1');"
                Call CreateAccessQuery("revalue", sql)
                
                If isQueryExist("mexchangereport") Then
                    DeleteAccessQuery ("mexchangereport")
                End If
                sql = "SELECT MoneyExchange.ID, (Right(MoneyExchange.mdate,2) & Mid(MoneyExchange.mdate,3,2)) AS cdatemonth, Mid(MoneyExchange.mdate,3,2) AS cmonth, Left(MoneyExchange.mdate,2) AS cYeaR, MoneyExchange.musd, MoneyExchange.mvnd, MoneyExchange.ROE, MoneyExchange.isBank, MoneyExchange.mType, MoneyExchange.moffc, MoneyExchange.idtype, MoneyExchange.mnumber, MoneyExchange.des, MoneyExchange.OFFICE, MoneyExchange.MoneyType from MoneyExchange WHERE (((MoneyExchange.Approved) Is Null Or (MoneyExchange.Approved)='' Or (MoneyExchange.Approved)='1'));"
                Call CreateAccessQuery("mexchangereport", sql)
                
                If isQueryExist("EXPLAINATION") Then
                    DeleteAccessQuery ("EXPLAINATION")
                End If
                sql = "SELECT detail.subid, (Right(detail.cdate,2) & Mid(detail.cdate,3,2)) AS cdatemonth, Mid(detail.cdate,3,2) AS cmonth, Left(detail.cdate,2) AS cYear, headers.isusd, headers.isbank, headers.ivalue, headers.itype, headers.ioffc, detail.inumber, detail.OFFICE, detail.doneby from detail, headers WHERE (((detail.subid)=headers.subid) And ((detail.OFFICE)=headers.office) And ((Left(headers.itype,1))='E') And ((detail.BillType)='IV')) And (detail.Approved Is Null Or detail.Approved='' Or detail.Approved='1');"
                Call CreateAccessQuery("EXPLAINATION", sql)
                
                If isQueryExist("expanditure") Then
                    DeleteAccessQuery ("expanditure")
                End If
                sql = "SELECT detail.subid, Mid(detail.cdate,3,2) AS cmonth, Left(detail.cdate,2) AS cYear, headers.isusd, headers.isbank, headers.ivalue, Left(headers.itype,5) AS codeType, Mid(headers.itype,6,4) AS PaidFor, headers.ioffc, detail.OFFICE, Right(headers.itype,3) AS financialYear from detail, headers WHERE (((detail.subid)=[headers].[subid]) AND ((detail.OFFICE)=[headers].[office]) AND ((Left([headers].[itype],1))='E') AND ((detail.BillType)='IV'))  and (detail.Approved is null or detail.Approved='' or  detail.Approved ='1');"
                Call CreateAccessQuery("expanditure", sql)
        End If
        
        If Not isTableExist("office", "expenditureReport") Then
            DeleteAccessQuery ("expenditureReport")
            sql = "SELECT Sum(expanditure.ivalue) AS TV, expanditure.subid, expanditure.cmonth, expanditure.cYear, expanditure.isusd, expanditure.isbank, expanditure.ioffc, expanditure.codeType, expanditure.PaidFor, expanditure.financialYear, expanditure.OFFICE from expanditure GROUP BY expanditure.subid, expanditure.cmonth, expanditure.cYear, expanditure.isusd, expanditure.isbank, expanditure.ioffc, expanditure.codeType, expanditure.PaidFor, expanditure.financialYear, expanditure.OFFICE;"
            Call CreateAccessQuery("expenditureReport", sql)
            returnValue = 1
        End If
        
        DeleteAccessQuery ("EXPLAINATION")
        sql = "SELECT detail.subid, (Right([detail].[cdate],2) & Mid([detail].[cdate],3,2)) AS cdatemonth, Mid([detail].[cdate],3,2) AS cmonth, Left([detail].[cdate],2) AS cYear, headers.isusd, headers.isbank, headers.ivalue, headers.itype, headers.ioffc, detail.inumber, detail.OFFICE, detail.doneby,detail.des from detail, headers WHERE (((detail.subid)=[headers].[subid]) AND ((detail.OFFICE)=[headers].[office]) AND ((Left([headers].[itype],1)='E') Or  Left([headers].[itype],1)='P')) AND ((detail.BillType)='IV') AND detail.Approved <> '0';"
        Call CreateAccessQuery("EXPLAINATION", sql)
    
        DeleteAccessQuery ("explainationreport")
        sql = "SELECT Sum(EXPLAINATION.ivalue) AS TV, EXPLAINATION.subid, EXPLAINATION.cdatemonth, EXPLAINATION.cmonth, EXPLAINATION.cYear, EXPLAINATION.isusd, EXPLAINATION.isbank, EXPLAINATION.itype, EXPLAINATION.ioffc, EXPLAINATION.doneby, EXPLAINATION.des, EXPLAINATION.inumber, EXPLAINATION.OFFICE from EXPLAINATION GROUP BY EXPLAINATION.subid, EXPLAINATION.cdatemonth, EXPLAINATION.cmonth, EXPLAINATION.cYear, EXPLAINATION.isusd, EXPLAINATION.isbank, EXPLAINATION.itype, EXPLAINATION.ioffc, EXPLAINATION.doneby, EXPLAINATION.des, EXPLAINATION.inumber, EXPLAINATION.OFFICE;"
        Call CreateAccessQuery("explainationreport", sql)
        
        Call DisconnectDB
        UpdateDatabase = returnValue
        Exit Function
    
err:
    UpdateDatabase = 0
End Function

Private Function DeleteAccessQuery(QueryName As String)
    On Error GoTo L
    Dim cat As ADOX.Catalog
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = adoConnection
    cat.Views.Delete QueryName
     
    Set cat = Nothing
L:
End Function

Private Function CreateAccessQuery(QueryName As String, SQLStr As String)

    Dim cat As ADOX.Catalog
    Dim cmd As ADODB.Command
      
    Set cat = New ADOX.Catalog
    Set cmd = New ADODB.Command
     
    cat.ActiveConnection = adoConnection
     
    cmd.CommandText = SQLStr
    cat.Views.Append QueryName, cmd
     
    Set cat = Nothing
    Set cmd = Nothing

End Function

Private Function isQueryExist(strQueryName As String) As Boolean
    On Error GoTo err
    Dim rs As New ADODB.Recordset
    Dim sql As String
     
    sql = "Select * from " & strQueryName
    rs.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    isQueryExist = True
    rs.Close
    Set rs = Nothing
    Exit Function
err:
    isQueryExist = False
 
End Function

Private Function isTableExist(strColumName As String, strTableName As String) As Boolean
    On Error GoTo err
    Dim rs As New ADODB.Recordset
    Dim sql As String
     
    sql = "Select " & strColumName & " from " & strTableName
    rs.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    isTableExist = True
    rs.Close
    Set rs = Nothing
    Exit Function
err:
    isTableExist = False
 
End Function
Public Function getMoneyTypeFromMoneyTransfer(mnumber As String) As String
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "Select MoneyType from MoneyExchange where mnumber='" & mnumber & "'"
    getMoneyTypeFromMoneyTransfer = ""
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        If Not IsNull(rs(0).Value) Then
            getMoneyTypeFromMoneyTransfer = rs(0).Value
        End If
    End If
    rs.Close
    Set rs = Nothing
End Function
Public Function RemoveItemME(subid As Integer, MEorTransfer As String, Office As String) As Boolean
    Dim sql As String
    Dim delOffice As String
    On Error GoTo err
    
    If MEorTransfer = "ME" Then
        sql = "delete * from MoneyExchange where office ='" & Office & "' and mtype ='M' and id =" & subid
    Else
        sql = "delete * from MoneyExchange where office ='" & Office & "' and mType ='T' and id =" & subid
    End If
    
    adoConnection.Execute (sql)
    RemoveItemME = True
    Exit Function
err:
    RemoveItemME = False
End Function

Public Sub KetNoi()
    On Error GoTo Errp
    Dim strPath As String
        strPath = GetAutoticketingDBPath
        
        If adoConnection.State = adStateOpen Then adoConnection.Close
        adoConnection.CursorLocation = adUseClient
        If Trim(strPath) = "" Then
            adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\db.mdb"
        Else
            adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath
        End If
        'MsgBox " Access the Database successful !", vbInformation + vbOKOnly, "Access"
        Exit Sub
Errp:
        MsgBox err.Description
End Sub

Public Function GetAutoticketingDBPath() As String
    Dim strLine As String
    If Dir(App.Path & "\datapath.ini") = "" Then
       GetAutoticketingDBPath = ""
       Exit Function
    End If
    Open App.Path & "\datapath.ini" For Input As #1
       Line Input #1, strLine
    Close #1
    GetAutoticketingDBPath = strLine
End Function


Public Function DisconnectDB()
    If Not adoConnection Is Nothing Then
        If adoConnection.State = adStateOpen Then
            adoConnection.Close
        End If
        Set adoConnection = Nothing
    End If
End Function

Public Function SetNegative(strValue As String, isNegative As Boolean) As String
    SetNegative = ""
    If Len(strValue) > 0 Then
        If Left(strValue, 1) <> "-" And isNegative Then
                SetNegative = "-" & strValue
        ElseIf Left(strValue, 1) <> "-" And Not isNegative Then
            SetNegative = strValue
        ElseIf Left(strValue, 1) = "-" And isNegative Then
            SetNegative = strValue
        ElseIf Left(strValue, 1) = "-" And Not isNegative Then
            SetNegative = Right(strValue, Len(strValue) - 1)
        End If
    End If
End Function
Public Function SelectText(oText As TextBox)
    oText.SelStart = 0
    oText.SelLength = Len(oText.Text)
End Function
Public Function GetBillTypeDescription(billcode As String) As String
    Select Case billcode
        Case "IV"
            GetBillTypeDescription = "Invoice"
        Case "BF"
            GetBillTypeDescription = "Budget flow"
        Case "RC"
            GetBillTypeDescription = "Receipt"
        Case "TI"
            GetBillTypeDescription = "Temporary invoice"
        Case "TR"
            GetBillTypeDescription = "Temporary receipt"
        Case "ME"
            GetBillTypeDescription = "Money exchange"
        Case Else
            GetBillTypeDescription = "Unkow Bill description"
    End Select
End Function

Public Function formatYYYYMMDD(ByVal dd As Integer, ByVal mm As Integer, ByVal yyyy As Integer) As String
    Dim tem As String
     
    tem = yyyy
    If Val(mm) < 10 Then
        tem = tem & "0" & Val(mm)
    Else
        tem = tem & Val(mm)
    End If
    
    If Val(dd) < 10 Then
        tem = tem & "0" & Val(dd)
    Else
        tem = tem & Val(dd)
    End If
     
    formatYYYYMMDD = tem
End Function

Public Function formatDDMM(mm As Integer, yy As Integer) As String
    Dim tem As String
    If Val(mm) < 10 Then
        tem = "0" & Val(mm)
    Else
        tem = mm
    End If
    If Val(yy) < 10 Then
        tem = tem & "0" & Val(yy)
    Else
        tem = tem & Val(yy)
    End If
    formatDDMM = tem
End Function

Public Function formatbillnumber(number As Integer) As String
    If number < 10 Then
        formatbillnumber = "00" & number
    ElseIf number < 100 Then
        formatbillnumber = "0" & number
    Else
        formatbillnumber = number
    End If
End Function
Public Function getBillNumber(whatkindofbill As String, MMYY As String, Office As String) As String
    Dim sql As String
    Dim maxnumber As Integer
    Dim BillType As String
    Dim adors As New ADODB.Recordset
    
    Select Case UCase(whatkindofbill)
            Case "IV"
                BillType = "I"
            Case "BF"
                BillType = "B"
            Case "RC"
                BillType = "R"
            Case "TI"
                BillType = "T"
            Case "TR"
                BillType = "T"
            Case "ME", "TRANSFER"
                BillType = "M"
            Case Else
                MsgBox "Sorry, I do not know what is kind of bill", vbCritical + vbOKOnly, "Get bill number message error"
                End
    End Select
    
    If BillType = "M" Then
        sql = "Select max(idtype) as maxnumber from MoneyExchange where  mid(mdate,3,2)& left(mdate,2) like '" & MMYY & "' and office ='" & stroffice & "'"
    Else
        sql = "Select max(idtype) as maxnumber from detail where  mid(cdate,3,2)& left(cdate,2) like '" & MMYY & "' and office ='" & stroffice & "' and left(inumber,1) ='" & BillType & "'"
    End If
    Set adors = adoConnection.Execute(sql)
    maxnumber = 1
    If Not adors.EOF Then
        If Not IsNull(adors.Fields(0).Value) Then
            maxnumber = adors.Fields(0).Value + 1
        Else
            maxnumber = 1
        End If
    End If
    adors.Close
    Set adors = Nothing
    getBillNumber = BillType & formatbillnumber(maxnumber) & "/" & MMYY & "/" & Office

End Function
Public Function getTypeForSearchForm(subid As Integer, Office As String) As String
    Dim sql As String
    Dim rs As New ADODB.Recordset
    'If permit <> "A" Then
       ' sql = "select * from headers  where office ='" & stroffice & "' And subid = " & subid
    'Else
        sql = "select * from headers  where office='" & Office & "' and subid = " & subid
    'End If
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        If rs.RecordCount > 1 Then
            getTypeForSearchForm = "Multiple"
        Else
            getTypeForSearchForm = GetFieldValue(rs.Fields("itype"))
        End If
    Else
        getTypeForSearchForm = "NULL"
    End If
    rs.Close
    Set rs = Nothing
End Function

Public Function RunAtTheFirstTime()
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "update headers set isusd='LAK' where isusd ='VND' and office='VTE'"
    adoConnection.Execute (sql)
    sql = "update headers set isusd='KHR' where isusd ='VND' and office='PNH'"
    adoConnection.Execute (sql)
    sql = "Select * from detail where office='VTE' or office='PNH'"
    rs.Open sql, adoConnection, adOpenDynamic, adLockOptimistic, adCmdText
    While Not rs.EOF
        If Len(GetFieldValue(rs.Fields("twords"))) > 3 Then
            If Right(GetFieldValue(rs.Fields("twords")), 3) = "Vnd" Then
                rs.Fields("twords").Value = SpellNumber(GetFieldValue(rs.Fields("tnumber"))) & " (LC)"
                rs.Update
            End If
        End If
        rs.MoveNext
    Wend
    rs.Close
    Set rs = Nothing
End Function




'=================================================
Function SpellNumber(ByVal MyNumber)
    Dim Dollars, Cents, temp
    Dim DecimalPlace, Count

    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' String representation of amount.
    MyNumber = Trim(str(MyNumber))

    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
            "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
        temp = GetHundreds(Right(MyNumber, 3))
        If temp <> "" Then Dollars = temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop

    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
        Case Else
            Dollars = Dollars & " Dollars"
    End Select

    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
        Case Else
            Cents = " and " & Cents & " Cents"
    End Select

    SpellNumber = Dollars & Cents
End Function
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    
    ' Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
    End If
    
    ' Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    
    GetHundreds = Result
End Function


Function GetTens(TensText)
    Dim Result As String

    Result = ""           ' Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
    Else                                 ' If value between 20-99...
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty "
            Case 3: Result = "Thirty "
            Case 4: Result = "Forty "
            Case 5: Result = "Fifty "
            Case 6: Result = "Sixty "
            Case 7: Result = "Seventy "
            Case 8: Result = "Eighty "
            Case 9: Result = "Ninety "
            Case Else
        End Select
        Result = Result & GetDigit _
            (Right(TensText, 1))  ' Retrieve ones place.
    End If
    GetTens = Result
End Function

Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function
      
Function Num2Text(s)
    Dim so
    Dim hang
    so = Array(" khong ", "mot", "hai", "ba", "bon", "nam", "sau", "bay", "tam", "chin")
    hang = Array("", "nghin", "trieu", "ti")
    Dim i
    Dim j
    Dim donvi
    Dim chuc
    Dim tram
    Dim str
    str = ""
    i = Len(s)
    j = 0
    If Left(s, 1) = "-" Then
        s = Right(s, Len(s) - 1)
    End If
    Do While j <= (i - 1)
        If Left(s, 1) = "0" Then
            s = Right(s, i - j)
        End If
     j = j + 1
    Loop
    If s = "0" Then
        Num2Text = so(0)
        Exit Function
    End If
    i = Len(s)
    If i = 0 Then
        str = ""
    Else
        j = 0
        Do While i > 0
            donvi = Int(Mid(s, i, 1))
            i = i - 1
            If i > 0 Then
                chuc = Int(Mid(s, i, 1))
            Else
                chuc = -1
            End If
            i = i - 1
            If i > 0 Then
                tram = Int(Mid(s, i, 1))
            Else
                tram = -1
            End If
            i = i - 1
            If donvi > 0 Or chuc > 0 Or tram > 0 Or (j Mod 3 = 0) Then
                If j Mod 3 <> 0 Then
                    str = hang((j - 1) Mod 3 + 1) & " " & str
                Else
                    If True Then
                        Dim temp
                        Dim k
                        temp = ""
                        For k = 1 To j \ 3
                            temp = " ti" + temp
                        Next
                        str = temp + ", " & str
                    End If
                End If
            End If
            j = j + 1
            If donvi = 1 And chuc > 1 Then
                str = "mot" & " " & str
            Else
                If donvi = 5 And chuc > 0 Then
                    str = "lam" & " " & str
                ElseIf donvi > 0 Then
                    str = so(donvi) & " " & str
                End If
            End If
            If chuc < 0 Then
                Exit Do
            Else
                If chuc = 0 And donvi > 0 Then
                    str = "le" & " " & str
                ElseIf chuc = 1 Then
                    str = "muoi" & " " & str
                ElseIf chuc > 1 Then
                    str = so(chuc) & " " & "muoi" & " " & str
                End If
            End If
            If tram < 0 Then
                Exit Do
            Else
                If tram > 0 Or chuc > 0 Or donvi > 0 Then
                    str = so(tram) & " " & "tram" & " " & str
                End If
            End If
        Loop
    End If
    Do While str <> Replace(str, ",  ti", ",")
        str = Replace(str, ",  ti", ", ")
    Loop
    Do While str <> Replace(str, ", ,", ",")
        str = Replace(str, ", ,", ",")
    Loop
    str = Trim(str)
    str = UCase(Left(str, 1)) & Right(str, Len(str) - 1)
    Num2Text = Left(str, Len(str) - 1) + " "
End Function


Public Function getOfficeForSearchForm(subid As Integer, Office As String) As String
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim temp As String
    Dim isMulti As Boolean
    'If permit <> "A" Then
       ' sql = "select * from headers  where office ='" & stroffice & "' And subid = " & subid
    'Else
        sql = "select * from headers  where office='" & Office & "' and subid = " & subid
    'End If
    Set rs = adoConnection.Execute(sql)
    If Not rs.EOF Then
        If rs.RecordCount > 1 Then
            temp = GetFieldValue(rs.Fields("ioffc"))
            isMulti = False
            rs.MoveNext
            While Not rs.EOF
                If temp <> GetFieldValue(rs.Fields("ioffc")) Then
                    isMulti = True
                End If
                rs.MoveNext
            Wend
            If isMulti Then
                getOfficeForSearchForm = "Multiple"
            Else
                getOfficeForSearchForm = temp
            End If
        Else
            getOfficeForSearchForm = GetFieldValue(rs.Fields("ioffc"))
        End If
    Else
        getOfficeForSearchForm = "NULL"
    End If
    rs.Close
    Set rs = Nothing
End Function
Public Function SetOffcValue(ComboB As ComboBox, bill As String)
    Dim sql As String
    Dim adors As New ADODB.Recordset
    Select Case bill
        Case "IV", "TI", "BF", "ME"
            sql = "Select distinct name from office where OS='O'"
        Case Else
            sql = "Select distinct name from office where OS='S'"
    End Select
    
    Set adors = adoConnection.Execute(sql)
    ComboB.Clear
    While Not adors.EOF
        ComboB.AddItem adors.Fields("name").Value
        adors.MoveNext
    Wend
    adors.Close
    Set adors = Nothing
     
    If bill = "IV" Or bill = "ME" Or bill = "BF" Then
       ComboB.Text = "G" & stroffice
       ComboB.Locked = True
    End If
End Function
Public Function SetTypeValue(ComboB As ComboBox, bill As String)
    Dim sql As String
    Dim adors As New ADODB.Recordset
    'If bill <> "IV" Then
    sql = "Select distinct name from typelist where bill ='" & bill & "'"
    Set adors = adoConnection.Execute(sql)
    ComboB.Clear
    While Not adors.EOF
        ComboB.AddItem adors.Fields("name").Value
        adors.MoveNext
    Wend
    adors.Close
    Set adors = Nothing
    'Else
    'ComboB.Clear
    'End If
End Function

Public Function GetItemType(TypeCode As String)
    Dim sql As String
    Dim adors As New ADODB.Recordset
    sql = "Select   des from typelist where name ='" & TypeCode & "'"
    Set adors = adoConnection.Execute(sql)
    If Not adors.EOF Then
        GetItemType = adors.Fields("des").Value
    Else
        GetItemType = ""
    End If
     
    adors.Close
    Set adors = Nothing
End Function

Public Function isTypeCorrect(strType As String) As String
    Dim sql As String
    Dim rs As New ADODB.Recordset
    isTypeCorrect = ""
    If Len(strType) <> 12 Then
        isTypeCorrect = "The type format is incorrect, The lengh of type must be included 12 characters."
        Exit Function
    End If
    
    sql = "Select Name from office where name ='" & UCase(Mid(strType, 6, 4)) & "'"
    Set rs = adoConnection.Execute(sql)
    If rs.EOF Then
        isTypeCorrect = "This office code '" & UCase(Mid(strType, 6, 4)) & "' is not exist."
        rs.Close
        Set rs = Nothing
        Exit Function
    End If
    
    rs.Close
    Set rs = Nothing
    If UCase(Right(strType, 1)) <> "F" And UCase(Right(strType, 1)) <> "S" Then
            isTypeCorrect = "The type format is incorrect, The last character must be 'S' or 'F'"
            Exit Function
    End If
    
    If Not IsNumeric(Mid(strType, 10, 2)) Then
        isTypeCorrect = "The type format is incorrect, Three last character must be 'YY<S>' or 'YY<F>'. YY is the financial year."
        Exit Function
    End If
    isTypeCorrect = ""
End Function
Public Function getOffice() As String
    Dim strLine As String
    Open App.Path & "\setting.ini" For Input As #1
       Line Input #1, strLine
    Close #1
    getOffice = Right(strLine, 3)
  
End Function

Public Function SetOffcValueME(ComboB As ComboBox)
    Dim sql As String
    Dim adors As New ADODB.Recordset
    sql = "Select distinct moffc from MoneyExchange where office ='" & stroffice & "'"
    Set adors = adoConnection.Execute(sql)
    ComboB.Clear
    While Not adors.EOF
        ComboB.AddItem adors.Fields("moffc").Value
        adors.MoveNext
    Wend
    adors.Close
    Set adors = Nothing
End Function
Public Function SetTypeValueME(ComboB As ComboBox)
    Dim sql As String
    Dim adors As New ADODB.Recordset
    sql = "Select distinct mtype from MoneyExchange where office ='" & stroffice & "'"
    Set adors = adoConnection.Execute(sql)
    ComboB.Clear
    While Not adors.EOF
        ComboB.AddItem adors.Fields("mtype").Value
        adors.MoveNext
    Wend
    adors.Close
    Set adors = Nothing
    If ComboB.ListCount >= 1 Then ComboB.ListIndex = 0
End Function
